home *** CD-ROM | disk | FTP | other *** search
/ Visual Basic Source Code / Visual Basic Source Code.iso / vbsource / cvdmbf / cvdmbf.bas next >
BASIC Source File  |  1995-05-09  |  6KB  |  234 lines
  1. Declare Sub hmemcpy Lib "kernel" (hpvDest As Any, hpvSource As Any, ByVal cbCopy As Long)
  2.  
  3. Function CVD (X As String) As Double
  4.  If Len(X) <> 8 Then
  5.   MsgBox "Illegal Function Call"
  6.   Stop
  7.  End If
  8.  hmemcpy temp#, ByVal X, 8
  9.  CVD = temp#
  10. End Function
  11.  
  12. Function CVDMBF (OldStringDP As String) As Double
  13.  Dim X, Sign, Exponent As Integer
  14.  Dim NewNum As String
  15.  Static ONA(0 To 7), NNA(0 To 7)
  16.  For X = 0 To 7
  17.   ONA(X) = Asc(Mid$(OldStringDP, X + 1, 1)): NNA(X) = 0
  18.  Next
  19.  Sign = ONA(6) And 128
  20.  Exponent = ONA(7) - 129 + 1023
  21.  NNA(6) = Exponent * 2 ^ 4 And 255
  22.  NNA(7) = (Exponent \ 2 ^ 4 And 255) Or Sign
  23.  For X = 6 To 1 Step -1
  24.   ONA(X) = ONA(X) * 2 ^ 1 And 255
  25.   ONA(X) = ONA(X) Or ONA(X - 1) \ 2 ^ 7 And 255
  26.  Next
  27.  ONA(0) = ONA(0) * 2 ^ 1 And 255
  28.  For X = 6 To 2 Step -1
  29.   NNA(X) = NNA(X) Or ONA(X) \ 2 ^ 4 And 255
  30.   NNA(X - 1) = ONA(X) * 2 ^ 4 And 255
  31.  Next
  32.  For X = 0 To 7
  33.   NewNum = NewNum + Chr$(NNA(X))
  34.  Next
  35.  CVDMBF = CVD(NewNum)
  36. End Function
  37.  
  38. Function CVDTPR (OldStringTP As String) As Double
  39.  Dim X, Sign, Exponent As Integer
  40.  Dim NewNum As String
  41.  Static ONA(0 To 5), NNA(0 To 7)
  42.  For X = 0 To 5
  43.   ONA(X) = Asc(Mid$(OldStringTP, X + 1, 1))
  44.  Next
  45.  For X = 0 To 7
  46.   NNA(X) = 0
  47.  Next
  48.  Sign = ONA(5) And 128
  49.  Exponent = ONA(0) - 129 + 1023
  50.  NNA(6) = Exponent * 2 ^ 4 And 255
  51.  NNA(7) = (Exponent \ 2 ^ 4 And 255) Or Sign
  52.  For X = 5 To 2 Step -1
  53.   ONA(X) = ONA(X) * 2 ^ 1 And 255
  54.   ONA(X) = ONA(X) Or ONA(X - 1) \ 2 ^ 7 And 255
  55.  Next
  56.  ONA(0) = ONA(0) * 2 ^ 1 And 255
  57.  For X = 6 To 2 Step -1
  58.   NNA(X) = NNA(X) Or ONA(X - 1) \ 2 ^ 4 And 255
  59.   NNA(X - 1) = ONA(X - 1) * 2 ^ 4 And 255
  60.  Next
  61.  For X = 0 To 7
  62.   NewNum = NewNum + Chr$(NNA(X))
  63.  Next
  64.  CVDTPR = CVD(NewNum)
  65. End Function
  66.  
  67. Function CVI (X As String) As Integer
  68.  If Len(X) <> 2 Then
  69.   MsgBox "Illegal Function Call"
  70.   Stop
  71.  End If
  72.  hmemcpy temp%, ByVal X, 2
  73.  CVI = temp%
  74. End Function
  75.  
  76. Function CVL (X As String) As Long
  77.  If Len(X) <> 4 Then
  78.   MsgBox "Illegal Function Call"
  79.   Stop
  80.  End If
  81.  hmemcpy temp&, ByVal X, 4
  82.  CVL = temp&
  83. End Function
  84.  
  85. Function CVS (X As String) As Single
  86.  If Len(X) <> 4 Then
  87.   MsgBox "Illegal Function Call"
  88.   Stop
  89.  End If
  90.  hmemcpy temp!, ByVal X, 4
  91.  CVS = temp!
  92. End Function
  93.  
  94. Function CVSMBF (OldStringSP As String) As Single
  95.  Dim X, Sign, Exponent As Integer
  96.  Dim NewNum As String
  97.  Static ONA(0 To 3), NNA(0 To 7)
  98.  For X = 0 To 3
  99.   ONA(X) = Asc(Mid$(OldStringSP, X + 1, 1))
  100.  Next
  101.  For X = 0 To 7
  102.   NNA(X) = 0
  103.  Next
  104.  Sign = ONA(2) And 128
  105.  Exponent = ONA(3) - 129 + 1023
  106.  NNA(6) = Exponent * 2 ^ 4 And 255
  107.  NNA(7) = (Exponent \ 2 ^ 4 And 255) Or Sign
  108.  For X = 2 To 1 Step -1
  109.   ONA(X) = ONA(X) * 2 ^ 1 And 255
  110.   ONA(X) = ONA(X) Or ONA(X - 1) \ 2 ^ 7 And 255
  111.  Next
  112.  ONA(0) = ONA(0) * 2 ^ 1 And 255
  113.  For X = 6 To 4 Step -1
  114.   NNA(X) = NNA(X) Or ONA(X - 4) \ 2 ^ 4 And 255
  115.   NNA(X - 1) = ONA(X - 4) * 2 ^ 4 And 255
  116.  Next
  117.  For X = 0 To 7
  118.   NewNum = NewNum + Chr$(NNA(X))
  119.  Next
  120.  CVSMBF = CSng(CVD(NewNum))
  121. End Function
  122.  
  123. Function MKD$ (X As Double)
  124.  temp$ = Space$(8)
  125.  hmemcpy ByVal temp$, X, 8
  126.  MKD$ = temp$
  127. End Function
  128.  
  129. Function MKDMBF$ (OldNumberDP As Double)
  130.  Dim X, Sign, Exponent As Integer
  131.  Dim NewNum As String
  132.  Dim OldString As String
  133.  Static ONA(0 To 7), NNA(0 To 7)
  134.  OldNum# = OldNumberDP
  135.  OldString = MKD$(OldNum#)
  136.  For X = 0 To 7
  137.   ONA(X) = Asc(Mid$(OldString, X + 1, 1))
  138.  Next
  139.  Sign = ONA(7) And 128
  140.  Exponent = ((ONA(7) And 127) * 2 ^ 4 And 255) + (ONA(6) \ 2 ^ 4 And 255)
  141.  If Exponent Then Exponent = (Exponent + 129 - 1023) And 255
  142.  For X = 6 To 1 Step -1
  143.   NNA(X) = ONA(X) * 2 ^ 4 And 255
  144.   NNA(X) = NNA(X) Or ONA(X - 1) \ 2 ^ 4 And 255
  145.  Next
  146.  For X = 0 To 5
  147.   NNA(X) = NNA(X) \ 2 ^ 1 And 255
  148.   NNA(X) = NNA(X) Or NNA(X + 1) * 2 ^ 7 And 255
  149.  Next
  150.  NNA(6) = NNA(6) \ 2 ^ 1 And 255
  151.  NNA(6) = NNA(6) Or Sign
  152.  NNA(7) = Exponent
  153.  MKDMBF$ = Space$(8)
  154.  For X = 0 To 7
  155.   Mid$(MKDMBF$, X + 1, 1) = Chr$(NNA(X))
  156.  Next
  157. End Function
  158.  
  159. Function MKDTPR$ (OldNumberDP As Double)
  160.  Dim X, Sign, Exponent As Integer
  161.  Dim NewNum, OldString As String
  162.  Static ONA(0 To 7), NNA(0 To 5)
  163.  OldNum# = OldNumberDP
  164.  OldString = MKD$(OldNum#)
  165.  For X = 0 To 7
  166.   ONA(X) = Asc(Mid$(OldString, X + 1, 1))
  167.  Next
  168.  Sign = ONA(7) And 128
  169.  Exponent = (((ONA(7) And 127) * 2 ^ 4 And 255) + (ONA(6) \ 2 ^ 4 And 255) + 129 - 1023) And 255
  170.  For X = 5 To 1 Step -1
  171.   NNA(X) = ONA(X + 1) * 2 ^ 4 And 255
  172.   NNA(X) = NNA(X) Or ONA(X) \ 2 ^ 4 And 255
  173.  Next
  174.  For X = 1 To 4
  175.   NNA(X) = NNA(X) \ 2 ^ 1 And 255
  176.   NNA(X) = NNA(X) Or NNA(X + 1) * 2 ^ 7 And 255
  177.  Next
  178.  NNA(5) = NNA(5) \ 2 ^ 1 And 255
  179.  NNA(5) = NNA(5) Or Sign
  180.  NNA(0) = Exponent
  181.  MKDTPR$ = Space$(6)
  182.  For X = 0 To 5
  183.   Mid$(MKDTPR$, X + 1, 1) = Chr$(NNA(X))
  184.  Next
  185. End Function
  186.  
  187. Function MKI$ (X As Integer)
  188.  temp$ = Space$(2)
  189.  hmemcpy ByVal temp$, X%, 2
  190.  MKI$ = temp$
  191. End Function
  192.  
  193. Function MKL$ (X As Long)
  194.  temp$ = Space$(4)
  195.  hmemcpy ByVal temp$, X&, 4
  196.  MKL$ = temp$
  197. End Function
  198.  
  199. Function MKS$ (X As Single)
  200.  temp$ = Space$(4)
  201.  hmemcpy ByVal temp$, X!, 4
  202.  MKS$ = temp$
  203. End Function
  204.  
  205. Function MKSMBF$ (OldNumberSP As Single)
  206.  Dim X, Sign, Exponent As Integer
  207.  Dim OldString As String
  208.  ReDim ONA(0 To 7)
  209.  ReDim NNA(0 To 3)
  210.  OldString = MKD$(CDbl(OldNumberSP))
  211.  For X = 0 To 7
  212.   ONA(X) = Asc(Mid$(OldString, X + 1, 1))
  213.  Next
  214.  Sign = ONA(7) And 128
  215.  Exponent = ((ONA(7) And 127) * 2 ^ 4 And 255) + (ONA(6) \ 2 ^ 4 And 255)
  216.  If Exponent Then Exponent = (Exponent + 129 - 1023) And 255
  217.  For X = 2 To 0 Step -1
  218.   NNA(X) = ONA(X + 4) * 2 ^ 4 And 255
  219.   NNA(X) = NNA(X) Or ONA(X + 3) \ 2 ^ 4 And 255
  220.  Next
  221.  For X = 0 To 1
  222.   NNA(X) = NNA(X) \ 2 ^ 1 And 255
  223.   NNA(X) = NNA(X) Or NNA(X + 1) * 2 ^ 7 And 255
  224.  Next
  225.  NNA(2) = NNA(2) \ 2 ^ 1 And 255
  226.  NNA(2) = NNA(2) Or Sign
  227.  NNA(3) = Exponent
  228.  MKSMBF$ = Space$(4)
  229.  For X = 0 To 3
  230.   Mid$(MKSMBF$, X + 1, 1) = Chr$(NNA(X))
  231.  Next
  232. End Function
  233.  
  234.